home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / SORT_UTL / MRGSORT / ERRMSGS.PAS < prev    next >
Pascal/Delphi Source File  |  1989-11-07  |  5KB  |  151 lines
  1. {$IFDEF ver50}                         (* <<-- change for other vers *)
  2. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V+}   (* must delete line for TP4 *)
  3. {$ELSE}
  4. {$R-,S-,I-,D+,T+,F-,V+,B-,N-,L+ }
  5. {$ENDIF}
  6.  
  7. UNIT errmsgs;
  8. (* allows proper explanation of run-time errors *)
  9.  
  10. (* ver 1.10 - Added Turbo 5 specific error messages *)
  11. (* ver 1.20 - More messages - covers 5.5 ??         *)
  12.  
  13. INTERFACE
  14.  
  15.   FUNCTION version(print : boolean) : integer;
  16.   (* Show version number, optionally display *)
  17.  
  18. IMPLEMENTATION
  19.  
  20.   CONST
  21.     ver       = 120;
  22.     copyrite  = ' Copyright (c) 1989 by C.B. Falconer';
  23.     errxx     : string[13] = 'Unknown error';
  24.     err001    : string[25] = 'Invalid DOS function code';
  25.     err002    : string[14] = 'File not found';
  26.     err003    : string[14] = 'Path not found';
  27.     err004    : string[19] = 'Too many open files';
  28.     err005    : string[18] = 'File access denied';
  29.     err006    : string[19] = 'Invalid file handle';
  30.     err008    : string[17] = 'Not enough memory';
  31. {}  err010    : string[19] = 'Invalid environment';
  32. {}  err011    : string[14] = 'Invalid format';
  33.     err012    : string[24] = 'Invalid file access code';
  34.     err015    : string[20] = 'Invalid drive number';
  35. {}  err016    : string[31] = 'Cannot remove current directory';
  36.     err017    : string[27] = 'Cannot rename across drives';
  37. {}  err018    : string[13] = 'No more files';
  38. {}  err048    : string[15] = 'Program aborted';
  39.     err100    : string[15] = 'Disk read error';
  40.     err101    : string[16] = 'Disk write error';
  41.     err102    : string[17] = 'File not assigned';
  42.     err103    : string[13] = 'File not open';
  43.     err104    : string[23] = 'File not open for input';
  44.     err105    : string[24] = 'File not open for output';
  45.     err106    : string[22] = 'Invalid numeric format';
  46.     err150    : string[20] = 'Disk write protected';
  47.     err151    : string[12] = 'Unknown unit';
  48.     err152    : string[15] = 'Drive not ready';
  49.     err153    : string[15] = 'Unknown command';
  50.     err154    : string[14] = 'Data CRC error';
  51.     err155    : string[24] = 'Bad drv rq structure lgh';
  52.     err156    : string[15] = 'Disk seek error';
  53.     err157    : string[18] = 'Unknown media type';
  54.     err158    : string[16] = 'Sector not found';
  55.     err159    : string[20] = 'Printer out of paper';
  56.     err160    : string[18] = 'Device write fault';
  57.     err161    : string[17] = 'Device read fault';
  58.     err162    : string[16] = 'Hardware failure';
  59.     err200    : string[16] = 'Division by zero';
  60.     err201    : string[17] = 'Range check error';
  61.     err202    : string[14] = 'Stack overflow';
  62.     err203    : string[13] = 'Heap overflow';
  63.     err204    : string[25] = 'Invalid pointer operation';
  64.     err205    : string[23] = 'Floating point overflow';
  65.     err206    : string[24] = 'Floating point underflow';         (*TP5*)
  66.     err207    : string[32] = 'Invalid floating point operation'; (*TP5*)
  67.     err208    : string[29] = 'Overlay manager not installed';    (*TP5*)
  68.     err209    : string[23] = 'Overlay file read error';          (*TP5*)
  69.  
  70.   VAR
  71.     saverrproc : pointer;
  72.     s          : pointer;    (* to string *)
  73.  
  74.   (* 1---------------1 *)
  75. {$f+}
  76.   PROCEDURE errprint;
  77.  
  78.     BEGIN (* errprint *)
  79.     exitproc := saverrproc; s := addr(errxx); (* default *)
  80.     IF longint(erroraddr) <> 0 THEN BEGIN
  81.       CASE exitcode OF
  82. 1:      s := addr(err001);
  83. 2:      s := addr(err002);
  84. 3:      s := addr(err003);
  85. 4:      s := addr(err004);
  86. 5:      s := addr(err005);
  87. 6:      s := addr(err006);
  88. 8:      s := addr(err008);
  89. 10:     s := addr(err010);
  90. 11:     s := addr(err011);
  91. 12:     s := addr(err012);
  92. 15:     s := addr(err015);
  93. 16:     s := addr(err016);
  94. 17:     s := addr(err017);
  95. 18:     s := addr(err018);
  96. 48:     s := addr(err048);
  97. 100:    s := addr(err100);
  98. 101:    s := addr(err101);
  99. 102:    s := addr(err102);
  100. 103:    s := addr(err103);
  101. 104:    s := addr(err104);
  102. 105:    s := addr(err105);
  103. 106:    s := addr(err106);
  104. 150:    s := addr(err150);
  105. 151:    s := addr(err151);
  106. 152:    s := addr(err152);
  107. 153:    s := addr(err153);
  108. 154:    s := addr(err154);
  109. 155:    s := addr(err155);
  110. 156:    s := addr(err156);
  111. 157:    s := addr(err157);
  112. 158:    s := addr(err158);
  113. 159:    s := addr(err159);
  114. 160:    s := addr(err160);
  115. 161:    s := addr(err161);
  116. 162:    s := addr(err162);
  117. 200:    s := addr(err200);
  118. 201:    s := addr(err201);
  119. 202:    s := addr(err202);
  120. 203:    s := addr(err203);
  121. 204:    s := addr(err204);
  122. 205:    s := addr(err205);
  123. 206:    s := addr(err206);
  124. 207:    s := addr(err207);
  125. 208:    s := addr(err208);
  126. 209:    s := addr(err209);
  127.    (* OTHERWISE uses the default errxx *)
  128.         END; (* case *)
  129.       writeln(string(s^)); END;
  130.     END; (* errprint *)
  131.  
  132.   (* 1---------------1 *)
  133.  
  134.   FUNCTION version(print : boolean) : integer;
  135.   (* Show version number, optionally display *)
  136.  
  137.     BEGIN (* version *)
  138.     version := ver;
  139.     IF print THEN BEGIN
  140.       write('ERRMSGS  module Version ', ver DIV 100 : 1, '.');
  141.       IF ver MOD 100 < 10 THEN write('0');
  142.       writeln(ver MOD 100, '.', copyrite); END;
  143.     END; (* version *)
  144.  
  145.   (* 1---------------1 *)
  146.  
  147.   BEGIN (* errmsgs initialization routine *)
  148.   saverrproc := exitproc; exitproc := addr(errprint);
  149.   IF version(false) <> ver THEN halt;
  150.   END. (* errmsgs *)
  151. u